Syntax10.Scn.Fnt
StampElems
Alloc
20 Mar 96
Syntax10i.Scn.Fnt
Syntax10b.Scn.Fnt
MODULE EditKeys;	(* CAS/MH 27 Jan 93, SHML 
 << *)
	IMPORT
		Files, Oberon, Input, Fonts, Display, Viewers, MenuViewers, Texts, TextFrames;
	CONST
		IdentLen = 32; DefaultFile = "EditKeys.Text"; DefaultMacro = "OTHERWISE"; InstallMacro = "INSTALL";
		(*scanner symbols*)
			cmdSym = 0; nameSym = 1; stretchSym = 2; lparen = 3; rparen = 4; bslash = 5; eof = 6;
		(*built-in commands*)
			(*w/ param*)
			writeCmd = "0"; charCmd = "1"; fntCmd = "2"; voffCmd = "3"; callCmd = "4";
			argCmd = "A"; execCmd = "B"; paramCmd = "C";
			(*w/o param*)
			keepCmd = "5"; pickCmd = "6"; caretCmd = "7"; indentCmd = "8"; freezeCmd = "9";
		(*preset.set*)
			fntPreset = 0; pickPreset = 1; voffPreset = 2; caretPreset = 3; freezePreset = 4;
		Menu = "System.Close  System.Copy  System.Grow  Edit.Search  Edit.Replace  Edit.Parcs  Edit.Store ";
		SysMenu = "System.Close  System.Copy  System.Grow  Edit.Store ";
	TYPE
		Ident = ARRAY IdentLen OF CHAR;
		Definition = POINTER TO DefinitionDesc;
		Sequence = POINTER TO SequenceDesc;
		DefinitionDesc = RECORD
			left, right: Definition;
			in: BOOLEAN;
			trig: Ident;
			seq: Sequence
		END;
		SequenceDesc = RECORD
			next: Sequence;
			sym: INTEGER;
			cmd: CHAR;
			def: Definition;
			stretch: Texts.Buffer
		END;
		defs, dmy: Definition;
		ch, cmd, hotKey: CHAR;
		sym, errs: INTEGER;
		errpos: LONGINT;
		name, trig: Ident;
		stretch, buf, indent: Texts.Buffer;
		T: Texts.Text;
		R: Texts.Reader;
		W, WB, WL: Texts.Writer;	(*out, compose, host editor*)
		map: ARRAY 17 OF CHAR;
		preset: RECORD
			set: SET;
			pos, caret: LONGINT;
			frame: TextFrames.Frame;
			def, fnt: Fonts.Font;
			voff: SHORTINT
		END;
	PROCEDURE Flip (VAR src, dst: ARRAY OF CHAR);
		VAR i, j: INTEGER;
	BEGIN i := -1; j := 0;
		REPEAT INC(i) UNTIL src[i] = 0X;
		WHILE i > 0 DO DEC(i); dst[j] := src[i]; INC(j) END;
		dst[j] := 0X
	END Flip;
	PROCEDURE WLog;
	BEGIN Texts.Append(Oberon.Log, W.buf)
	END WLog;
	PROCEDURE Ch (ch: CHAR);
	BEGIN Texts.Write(W, ch)
	END Ch;
	PROCEDURE Str (s: ARRAY OF CHAR);
	BEGIN Texts.WriteString(W, s)
	END Str;
	PROCEDURE FlipStr (s: ARRAY OF CHAR);
		VAR n: Ident;
	BEGIN Flip(s, n); Str(n)
	END FlipStr;
	PROCEDURE Gap;
	BEGIN Str("  ")
	END Gap;
	PROCEDURE Ln;
	BEGIN Texts.WriteLn(W)
	END Ln;
	PROCEDURE Char (ch: CHAR);
		VAR pat: Display.Pattern; i, n, dx, x, y, w, h: INTEGER;
			d: ARRAY 3 OF CHAR;
	BEGIN Display.GetChar(W.fnt.raster, ch, dx, x, y, w, h, pat);
		IF h > 0 THEN Ch(ch); Str(" (* ") END;
		Ch("#"); i := 0; n := ORD(ch);
		REPEAT d[i] := map[n MOD 10]; n := n DIV 10; INC(i) UNTIL n = 0;
		WHILE i > 0 DO DEC(i); Ch(d[i]) END;
		IF h = 0 THEN Str(" (* ") ELSE Str(", ") END;
		Ch("0"); i := 0; n := ORD(ch);
		REPEAT d[i] := map[n MOD 16]; n := n DIV 16; INC(i) UNTIL n = 0;
		WHILE i > 0 DO DEC(i); Ch(d[i]) END;
		Str("X *)")
	END Char;
	PROCEDURE Append (SB, DB: Texts.Buffer);
	BEGIN Texts.Copy(SB, DB); Texts.OpenBuf(SB)
	END Append;
	(* table handler *)
	PROCEDURE Find (VAR name, trig: Ident; insert: BOOLEAN): Definition;
		VAR p, q, d, x: Definition; i: INTEGER;
	BEGIN Flip(name, trig); p := defs; d := p.right; q := NIL; x := NIL;
		WHILE d # NIL DO i := 0;
			WHILE (trig[i] # 0X) & (trig[i] = d.trig[i]) DO INC(i) END;
			IF trig[i] = d.trig[i] THEN x := d; d := NIL
			ELSIF trig[i] = 0X THEN q := d; d := NIL
			ELSIF trig[i] < d.trig[i] THEN p := d; d := d.left
			ELSE p := d; d := d.right
			END
		END;
		IF insert & (x # NIL) THEN Str(name); Str(" already defined"); Ln; WLog END;	(*<<*)
		IF insert & (x = NIL) THEN NEW(x); x.right := q; x.in := FALSE; x.trig := trig;
			IF trig < p.trig THEN p.left := x ELSE p.right := x END;
			IF q # NIL THEN dmy.right := NIL; p := dmy;
				WHILE q.left # NIL DO
					WHILE (q.left # NIL) & (q.left.trig > trig) DO q := q.left END;
					WHILE (q.left # NIL) & (q.left.trig < trig) DO p.right := q.left; p := p.right; q.left := p.right; p.right := NIL END
				END;
				x.left := dmy.right
			END
		END;
		RETURN x
	END Find;
	PROCEDURE ResetDefs;
		VAR def: Definition; seq: Sequence;
	BEGIN defs.right := NIL; defs.trig[0] := 0X; hotKey := "\";
		name := DefaultMacro; def := Find(name, trig, TRUE);
		NEW(def.seq); seq := def.seq;
		seq.sym := cmdSym; seq.cmd := pickCmd;
		NEW(seq.next); seq := seq.next;
		Texts.OpenBuf(WB.buf); Texts.Write(WB, "\");
		seq.sym := stretchSym; seq.stretch := WB.buf;
		NEW(WB.buf); Texts.OpenBuf(WB.buf);
		NEW(seq.next); seq := seq.next;
		seq.sym := cmdSym; seq.cmd := writeCmd
	END ResetDefs;
	PROCEDURE Trigger (VAR trig: Ident): Definition;
		VAR d, x: Definition; i: INTEGER;
	BEGIN d := defs.right; x := NIL;
		WHILE d # NIL DO i := 0;
			WHILE (trig[i] # 0X) & (trig[i] = d.trig[i]) DO INC(i) END;
			IF trig[i] = d.trig[i] THEN RETURN d END;
			IF d.trig[i] = 0X THEN x := d END;
			IF trig[i] < d.trig[i] THEN d := d.left ELSE d := d.right END
		END;
		RETURN x
	END Trigger;
	(* macro compiler *)
	PROCEDURE Mark (err: ARRAY OF CHAR);
	BEGIN INC(errs);
		IF Texts.Pos(R) - errpos > 9 THEN
			errpos := Texts.Pos(R); Ln; Str("  pos  "); Texts.WriteInt(W, errpos, 0); Gap; Str(err); WLog
		END
	END Mark;
	PROCEDURE GetCh;
	BEGIN Texts.Read(R, ch)
	END GetCh;
	PROCEDURE CharCode;
		VAR c: INTEGER;
	BEGIN c := 0;
		WHILE ("0" <= ch) & (ch <= "9") DO c := c * 10 + SHORT(ORD(ch) - 30H); GetCh END;
		name[0] := CHR(c); name[1] := 0X	(*unchecked*)
	END CharCode;
	PROCEDURE Name;
		VAR i: INTEGER;
	BEGIN i := 0;
		REPEAT name[i] := ch; INC(i); GetCh
		UNTIL (ch <= " ") OR (ch = "(") OR (ch = ")") OR R.eot OR (i = IdentLen-1);
		IF ~((ch <= " ") OR (ch = "(") OR (ch = ")") OR R.eot) THEN Mark("name too long") END;
		name[i] := 0X
	END Name;
	PROCEDURE Save (text: Texts.Text; beg, end: LONGINT; buf: Texts.Buffer);
	BEGIN
		IF end > beg THEN Texts.Save(text, beg, end, buf) END
	END Save;
	PROCEDURE Stretch;
		VAR beg, end: LONGINT;
	BEGIN beg := Texts.Pos(R); end := beg; GetCh;
		WHILE ~R.eot & (ch # 22X) DO INC(end); GetCh END;
		IF ch = 22X THEN GetCh;
			IF end > beg THEN NEW(stretch); Texts.OpenBuf(stretch); Save(T, beg, end, stretch)
			ELSE Mark("empty stretch")
			END
		ELSE Mark("Closing quote expected")
		END
	END Stretch;
	PROCEDURE Comment;
	BEGIN
		LOOP
			IF ch = "(" THEN GetCh;
				IF ch = "*" THEN GetCh; Comment END
			ELSIF ch = "*" THEN GetCh;
				IF ch = ")" THEN GetCh; EXIT END
			ELSE GetCh
			END
		END
	END Comment;
	PROCEDURE GetSym;
	BEGIN sym := eof;
		REPEAT
			IF (0X <= ch) & (ch <= " ") THEN GetCh
			ELSIF ch = 22X THEN sym := stretchSym; Stretch
			ELSIF ch = "#" THEN sym := nameSym; GetCh; CharCode
			ELSIF ch = "(" THEN GetCh; IF ch = "*" THEN GetCh; Comment ELSE sym := lparen END
			ELSIF ch = ")" THEN sym := rparen; GetCh
			ELSIF ch = "\" THEN sym := bslash; GetCh
			ELSIF ch = "^" THEN sym := cmdSym; GetCh; cmd := ch; GetCh
			ELSE sym := nameSym; Name
			END
		UNTIL (sym # eof) OR R.eot
	END GetSym;
	PROCEDURE ParseText;
		VAR def: Definition; beg, seq: Sequence;
	BEGIN GetSym;
		IF sym = bslash THEN
			GetSym; IF sym = nameSym THEN hotKey := name[0]; GetSym ELSE Mark("hot-key code expected") END
		END;
		WHILE sym = nameSym DO GetSym; def := Find(name, trig, TRUE);
			IF sym = lparen THEN
				GetSym; NEW(beg); seq := beg; beg.next := NIL;
				WHILE sym IN {cmdSym, nameSym, stretchSym} DO
					NEW(seq.next); seq := seq.next; seq.sym := sym;
					IF sym = cmdSym THEN seq.cmd := cmd
					ELSIF sym = nameSym THEN seq.def := Find(name, trig, FALSE);
						IF seq.def = NIL THEN Mark("illegal forward reference") END
					ELSE (*sym = stretchSym*) seq.stretch := stretch
					END;
					GetSym
				END;
				def.seq := beg.next; IF sym = rparen THEN GetSym ELSE Mark(") expected") END
			ELSE Mark("( expected")
			END
		END;
		IF sym # eof THEN GetSym;
			IF sym # eof THEN Mark("unexpected trailing char.s") END
		END;
		stretch := NIL
	END ParseText;
	PROCEDURE ReadText (name: ARRAY OF CHAR; beg: LONGINT);
	BEGIN Texts.OpenReader(R, T, beg); GetCh;
		IF ~R.eot THEN Str("  reading "); Str(name); WLog; errs := 0; errpos := -10; ParseText;
			IF errs = 0 THEN Str(" done") ELSE ResetDefs END;
			Ln; WLog
		END
	END ReadText;
	(* macro processor *)
	PROCEDURE Insert (frame: TextFrames.Frame; buf: Texts.Buffer);
		VAR pos, len: LONGINT;
	BEGIN pos := frame.carloc.pos; len := buf.len;
		Texts.Insert(frame.text, pos, buf); TextFrames.SetCaret(frame, pos + len)
	END Insert;
	PROCEDURE Delete (frame: TextFrames.Frame; beg, end: LONGINT);
	BEGIN Texts.Delete(frame.text, beg, end); TextFrames.SetCaret(frame, beg)
	END Delete;
	PROCEDURE Err (def: Definition; s: ARRAY OF CHAR);
	BEGIN INC(errs); Gap; Str(s); Str(" in "); FlipStr(def.trig); Ln; WLog
	END Err;
	PROCEDURE PopArg (def: Definition; class: SHORTINT; VAR S: Texts.Scanner; VAR stack: Sequence);
		VAR B: Texts.Buffer;
	BEGIN
		IF stack # NIL THEN T := TextFrames.Text("");
			NEW(B); Texts.OpenBuf(B); Texts.Copy(stack.stretch, B);
			Texts.Append(T, B); Texts.OpenScanner(S, T, 0); Texts.Scan(S); stack := stack.next;
			IF (class >= 0) & (S.class # class) THEN Err(def, "illegal param type") END
		ELSE Err(def, "missing param")
		END
	END PopArg;
	PROCEDURE PushArg (buf: Texts.Buffer; VAR stack: Sequence);
		VAR u: Sequence;
	BEGIN NEW(u); u.next := stack; stack := u; u.stretch := buf
	END PushArg;
	PROCEDURE ThisArg (n: LONGINT; args: Sequence): Sequence;
	BEGIN
		WHILE (n > 0) & (args # NIL) DO DEC(n); args := args.next END;
		RETURN args
	END ThisArg;
	PROCEDURE GetArguments (text: Texts.Text; pos: LONGINT; VAR pin: LONGINT; VAR args: Sequence);
		VAR B: Texts.Buffer; R: Texts.Reader; ch: CHAR;
	BEGIN pin := pos; DEC(pos); Texts.OpenReader(R, text, pos); Texts.Read(R, ch);
		IF ch = ":" THEN pin := pos;
			WHILE pos > 0 DO DEC(pos); Texts.OpenReader(R, text, pos); Texts.Read(R, ch); (*inv text[pos] = ch*)
				IF ch <= " " THEN
					NEW(B); Texts.OpenBuf(B); Save(text, pos + 1, pin, B); PushArg(B, args);
					pin := pos + 1; RETURN
				ELSIF ch = ":" THEN
					NEW(B); Texts.OpenBuf(B); Save(text, pos + 1, pin, B); PushArg(B, args);
					pin := pos
				ELSIF (ch = 22X) & (pos = pin - 1) THEN ch := 0X;
					WHILE (pos > 0) & (ch # 22X) DO DEC(pos); Texts.OpenReader(R, text, pos); Texts.Read(R, ch) END;
					IF ch = 22X THEN
						NEW(B); Texts.OpenBuf(B); Save(text, pos + 1, pin - 1, B); PushArg(B, args);
						pin := pos;
						DEC(pos); Texts.OpenReader(R, text, pos); Texts.Read(R, ch);
						IF ch = ":" THEN pin := pos END;
						IF ch <= " " THEN RETURN END
					ELSE RETURN
					END
				END
			END;
			NEW(B); Texts.OpenBuf(B); Save(text, pos, pin, B); PushArg(B, args);
			pin := pos
		END
	END GetArguments;
	PROCEDURE Expand (def: Definition; VAR stack, args, params: Sequence);
		VAR d: Definition; seq, u: Sequence; B: Texts.Buffer; S: Texts.Scanner; par: Oberon.ParList; res: INTEGER;
	BEGIN
		IF ~def.in THEN def.in := TRUE; seq := def.seq;
			WHILE (errs = 0) & (seq # NIL) DO
				IF seq.sym = cmdSym THEN
					IF seq.cmd = writeCmd THEN
						IF stack # NIL THEN Append(stack.stretch, buf); stack := stack.next
						ELSE Err(def, "missing param")
						END
					ELSIF seq.cmd = charCmd THEN PopArg(def, Texts.Int, S, stack);
						Texts.Write(WB, CHR(S.i)); Append(WB.buf, buf)
					ELSIF seq.cmd = fntCmd THEN PopArg(def, Texts.Name, S, stack);
						INCL(preset.set, fntPreset); preset.fnt := Fonts.This(S.s)
					ELSIF seq.cmd = voffCmd THEN PopArg(def, Texts.Int, S, stack);
						INCL(preset.set, voffPreset); preset.voff := SHORT(SHORT(S.i))
					ELSIF seq.cmd = callCmd THEN PopArg(def, Texts.Name, S, stack);
						IF errs = 0 THEN NEW(par); par.vwr := Oberon.FocusViewer; par.frame := par.vwr.dsc.next;
							IF params # NIL THEN
								par.text := TextFrames.Text("");
								WHILE params # NIL DO Texts.Insert(par.text, 0, params.stretch);
									params := params.next
								END;
								NEW(B); Texts.OpenBuf(B);
								Texts.Save(T, Texts.Pos(S) - 1, T.len, B); Texts.Append(par.text, B);
								par.pos := 0
							ELSE par.text := T; par.pos := Texts.Pos(S)
							END;
							Oberon.Call(S.s, par, FALSE, res);
							IF res # 0 THEN Texts.WriteInt(W, res, 3); Err(def, "call error ") END
						END
					ELSIF seq.cmd = argCmd THEN PopArg(def, Texts.Int, S, stack);
						IF errs = 0 THEN u := ThisArg(S.i, args);
							IF u # NIL THEN NEW(B); Texts.OpenBuf(B); Texts.Copy(u.stretch, B); PushArg(B, stack)
							ELSE Err(def, "missing argument")
							END
						END
					ELSIF seq.cmd = execCmd THEN PopArg(def, Texts.Name, S, stack);
						IF errs = 0 THEN COPY(S.s, name); d := Find(name, trig, FALSE);
							IF d # NIL THEN Expand(d, stack, args, params)
							ELSE Err(def, "exec of undefined macro")
							END
						END
					ELSIF seq.cmd = paramCmd THEN
						IF stack # NIL THEN u := stack; stack := stack.next; u.next := params; params := u
						ELSE Err(def, "missing param")
						END
					ELSIF seq.cmd = keepCmd THEN INCL(preset.set, fntPreset); preset.fnt := preset.def
					ELSIF seq.cmd = pickCmd THEN INCL(preset.set, pickPreset)
					ELSIF seq.cmd = caretCmd THEN INCL(preset.set, caretPreset); preset.caret := buf.len
					ELSIF seq.cmd = indentCmd THEN
						IF indent.len > 0 THEN Texts.Copy(indent, buf) END
					ELSIF seq.cmd = freezeCmd THEN INCL(preset.set, freezePreset)
					ELSE Err(def, "illegal built-in")
					END
				ELSIF seq.sym = nameSym THEN Expand(seq.def, stack, args, params)
				ELSE (*seq.sym = stretchSym*)
					NEW(B); Texts.OpenBuf(B); Texts.Copy(seq.stretch, B); PushArg(B, stack)
				END;
				seq := seq.next
			END;
			def.in := FALSE
		ELSE Err(def, "cyclic expansion")
		END
	END Expand;
	PROCEDURE InitialExec (name: Ident);
		VAR def: Definition; stack, args, params: Sequence; trig: Ident;
	BEGIN def := Find(name, trig, FALSE);
		IF def # NIL THEN preset.set := {}; stack := NIL; args := NIL; params := NIL; errs := 0;
			Expand(def, stack, args, params);
			IF stack # NIL THEN Err(def, "superfluous param") END
		END
	END InitialExec;
	PROCEDURE Process (frame: TextFrames.Frame; VAR del: LONGINT);
		VAR def: Definition; org, pos, i, tlen, pin: LONGINT; stack, args, params: Sequence; default: BOOLEAN;
dmy: Texts.Reader;
	BEGIN errs := 0; del := 0; Texts.OpenBuf(buf); org := frame.carloc.pos;
		pos := org - (IdentLen-1);
		IF pos >= 0 THEN i := IdentLen-1 ELSE pos := 0; i := org END;
		trig[i] := 0X; Texts.OpenReader(R, frame.text, pos);
		WHILE i > 0 DO DEC(i); Texts.Read(R, trig[i]) END;
		def := Trigger(trig);
		IF def # NIL THEN default := FALSE; tlen := 0;
			WHILE def.trig[tlen] # 0X DO INC(tlen) END
		ELSE default := TRUE; name := DefaultMacro; def := Find(name, trig, FALSE); tlen := 0
		END;
		IF def # NIL THEN preset.set := {}; stack := NIL; args := NIL; params := NIL;
			GetArguments(frame.text, org - tlen, pin, args);
Texts.OpenReader(dmy, frame.text, 0);
			Expand(def, stack, args, params);
			IF stack # NIL THEN Err(def, "superfluous param") END;
			IF errs = 0 THEN
				IF ~default THEN del := org - pin END;
				preset.frame := frame; preset.pos := frame.carloc.pos - del;
				IF caretPreset IN preset.set THEN INC(preset.pos, preset.caret) ELSE INC(preset.pos, buf.len) END
			END
		END
	END Process;
	(* editor interface *)
	PROCEDURE Key (frame: TextFrames.Frame; ch: CHAR; VAR handled: BOOLEAN);
		CONST TAB = 9X; LF = 0AX; CR = 0DX;
		VAR del, pos, beg: LONGINT; voff: SHORTINT; fnt: Fonts.Font; ch1: CHAR;
	BEGIN handled := TRUE; pos := frame.carloc.pos;
		IF frame.text.len > 0 THEN
			IF pos < frame.text.len THEN Texts.OpenReader(R, frame.text, pos); Texts.Read(R, ch1) END;
			IF (pos > 0) & ((pos = frame.text.len) OR (ch1 <= " ")) THEN
				Texts.OpenReader(R, frame.text, pos - 1); Texts.Read(R, ch1)
			END;
			preset.def := R.fnt; Texts.SetColor(WL, R.col);
			IF (ch = CR) OR (ch = TAB) OR (ch = LF) THEN Texts.SetOffset(WL, Oberon.CurOff)
			ELSE Texts.SetOffset(WL, R.voff)
			END
		ELSE preset.def :=  Oberon.CurFnt; Texts.SetColor(WL, Oberon.CurCol); Texts.SetOffset(WL, Oberon.CurOff)
		END;
		fnt := preset.def; voff := WL.voff;
		IF (preset.frame = frame) & (preset.pos = pos) THEN
			IF fntPreset IN preset.set THEN fnt := preset.fnt END;
			IF voffPreset IN preset.set THEN voff := preset.voff END
		END;
		preset.set := {}; preset.frame := NIL;
		IF WL.fnt # fnt THEN Texts.SetFont(WL, fnt) END;
		IF WL.voff # voff THEN Texts.SetOffset(WL, voff) END;
		IF ch = hotKey THEN beg := frame.carloc.org; Texts.OpenReader(R, frame.text, beg); Texts.Read(R, ch1);
			WHILE (Texts.Pos(R) <= pos) & (ch1 <= " ") DO Texts.Read(R, ch1) END;
			Texts.OpenBuf(indent); Save(frame.text, beg, Texts.Pos(R) - 1, indent);
			Process(frame, del);
			IF ~(freezePreset IN preset.set) & (errs = 0) THEN
				IF frame.hasCar & (frame.carloc.pos # pos) THEN preset.pos := frame.carloc.pos - del END;
				TextFrames.SetCaret(frame, pos);
				IF del > 0 THEN Delete(frame, pos - del, pos) END;
				IF pickPreset IN preset.set THEN T := TextFrames.Text("");
					Texts.Append(T, buf); Texts.ChangeLooks(T, 0, T.len, {0}, preset.def, 0, 0);
					Save(T, 0, T.len, buf)
				END;
				Insert(frame, buf)
			ELSE TextFrames.RemoveCaret(frame); preset.pos := frame.carloc.pos
			END;
			IF (0 <= preset.pos) & (preset.pos <= frame.text.len) THEN
				TextFrames.SetCaret(frame, preset.pos)
			END
		(*ELSIF (ch >= " ") & (ch # DEL) & (ch < 95X) OR (ch = 9BX) OR (ch = 9FX) THEN Texts.Write(WL, ch)*)
		ELSE handled := FALSE
		END;
		IF (WL.buf.len > 0) & frame.hasCar THEN Insert(frame, WL.buf) END
	END Key;
	PROCEDURE KeyHandle*(f: Display.Frame; VAR msg: Display.FrameMsg);	(*<<*)
		CONST InvalMsg = -1;
		VAR frame: TextFrames.Frame; handled: BOOLEAN;
	BEGIN
		IF msg IS Oberon.InputMsg THEN
			WITH msg: Oberon.InputMsg DO
				frame := f(TextFrames.Frame);
				IF (msg.id = Oberon.consume) & frame.hasCar THEN
					Key(frame, msg.ch, handled);
					IF handled THEN msg.id := InvalMsg END
				ELSIF (msg.id = Oberon.track) & (msg.keys # {}) THEN preset.set := {}
				END
			END
		END
	END KeyHandle;
	PROCEDURE Handle* (F: Display.Frame; VAR msg: Display.FrameMsg);
	BEGIN KeyHandle(F, msg); TextFrames.Handle(F, msg)
	END Handle;
	(* commands *)
	PROCEDURE GetMainArg (VAR S: Texts.Scanner; VAR end: LONGINT);
		(*after command or (^) at selection; end of selection or -1*)
		VAR text: Texts.Text; beg, time: LONGINT;
	BEGIN Texts.Scan(S); end := -1;
		IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(text, beg, end, time);
			IF time >= 0 THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) END
		END;
		IF S.line # 0 THEN S.class := Texts.Inval END
	END GetMainArg;
	PROCEDURE ShowPos (F: TextFrames.Frame; pos: LONGINT);
		VAR beg, end, delta: LONGINT;
	BEGIN delta := 200;
		LOOP beg := F.org; end := TextFrames.Pos(F, F.X + F.W, F.Y);
			IF (beg <= pos) & (pos < end) OR (delta = 0) THEN EXIT END;
			TextFrames.Show(F, pos - delta); DEC(delta, 20)
		END
	END ShowPos;
	PROCEDURE NewView (name: ARRAY OF CHAR; class: INTEGER;
			T: Texts.Text; org: LONGINT; sys: BOOLEAN): TextFrames.Frame;
		VAR V: MenuViewers.Viewer; F, M: TextFrames.Frame; buf: Texts.Buffer; i, x, y: INTEGER;
	BEGIN
		IF class = Texts.String THEN i := 0;
			WHILE name[i] # 0X DO INC(i) END;
			name[i] := 22X; INC(i); name[i] := 0X;
			WHILE i >= 0 DO name[i+1] := name[i]; DEC(i) END;
			name[0] := 22X
		END;
		F := TextFrames.NewText(T, org);
		F.handle := Handle;
		IF sys THEN Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y);
			V := MenuViewers.New(TextFrames.NewMenu(name, SysMenu), F, TextFrames.menuH, x, y)
		ELSE Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
			IF Files.Old("Edit.Menu.Text") = NIL THEN M := TextFrames.NewMenu(name, Menu)
			ELSE M := TextFrames.NewMenu(name, "");
				NEW(T); Texts.Open(T, "Edit.Menu.Text");
				NEW(buf); Texts.OpenBuf(buf); Texts.Save(T, 0, T.len, buf); Texts.Append(M.text, buf)
			END;
			V := MenuViewers.New(M, F, TextFrames.menuH, x, y)
		END;
		ShowPos(F, org);
		RETURN F
	END NewView;
	PROCEDURE Open*;
		VAR S: Texts.Scanner; F: TextFrames.Frame; end: LONGINT;
	BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); GetMainArg(S, end);
		IF (S.class = Texts.Name) OR (S.class = Texts.String) THEN
			F := NewView(S.s, S.class, TextFrames.Text(S.s), 0, FALSE)
		END
	END Open;
	PROCEDURE SysOpen*;
		VAR S: Texts.Scanner; F: TextFrames.Frame; end: LONGINT;
	BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); GetMainArg(S, end);
		IF (S.class = Texts.Name) OR (S.class = Texts.String) THEN
			F := NewView(S.s, S.class, TextFrames.Text(S.s), 0, TRUE)
		END
	END SysOpen;
	PROCEDURE Upgrade*;	(*<< ww *)
		VAR v: Viewers.Viewer; f: Display.Frame; hT, h: Display.Handler;
	BEGIN v := Oberon.MarkedViewer();
		IF (v.dsc # NIL) & (v.dsc.next # NIL) THEN f := v.dsc.next; hT := TextFrames.Handle; h := Handle;
			IF f.handle = hT THEN f.handle := h
			ELSIF f.handle # h THEN Str("EditKeys.Upgrade: Not a TextFrame."); Ln; WLog
			END
		END
	END Upgrade;
	PROCEDURE GetKeyHandler*;	(*<<*)
		CONST Magic = -42;
	BEGIN
		IF Oberon.Par.pos = Magic THEN Oberon.Par.frame.handle := KeyHandle END
	END GetKeyHandler;
	PROCEDURE Reset*;
	BEGIN ResetDefs
	END Reset;
	PROCEDURE Read*;
		VAR S: Texts.Scanner; text: Texts.Text; beg, end, time: LONGINT;
	BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
		IF (S.class = Texts.Char) & (S.c = "@") & (S.line = 0) THEN
			Oberon.GetSelection(text, beg, end, time);
			IF time > 0 THEN T := text; ReadText(" @ ", beg) END
		ELSIF (S.class = Texts.Char) & (S.c = ":") & (S.nextCh = "=") & (S.line = 0) THEN Texts.Scan(S);
			T := Oberon.Par.text; ReadText(" := ", Texts.Pos(S) - 1)
		ELSE
			IF (S.class = Texts.Char) & (S.c = "^") & (S.line = 0) THEN
				Oberon.GetSelection(text, beg, end, time);
				IF time > 0 THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) END
			END;
			WHILE S.class = Texts.Name DO T := TextFrames.Text(S.s); ReadText(S.s, 0); Texts.Scan(S) END
		END;
		T := NIL
	END Read;
	PROCEDURE Definitions*;
		VAR S: Texts.Scanner; V: MenuViewers.Viewer; T, text: Texts.Text; tree: Definition;
			beg, end, time: LONGINT; x, y: INTEGER;
		PROCEDURE Sort(VAR d: Definition; VAR pat: ARRAY OF CHAR; VAR tree: Definition);
			VAR i: INTEGER; t: Definition; n: Ident;
			PROCEDURE Ins(VAR tree: Definition; t: Definition; VAR n: Ident);
				VAR m: Ident;
			BEGIN
				IF tree = NIL THEN tree := t
				ELSE Flip(tree.trig, m);
					IF n < m THEN Ins(tree.left, t, n) ELSE Ins(tree.right, t, n) END
				END
			END Ins;
		BEGIN
			IF d # NIL THEN Flip(d.trig, n); i := 0;
				WHILE (pat[i] # 0X) & (n[i] = pat[i]) DO INC(i) END;
				IF pat[i] = 0X THEN NEW(t); t^ := d^; t.left := NIL; t.right := NIL; Ins(tree, t, n) END;
				Sort(d.left, pat, tree); Sort(d.right, pat, tree)
			END
		END Sort;
		PROCEDURE Write(tree: Definition);
			PROCEDURE Seq(seq: Sequence);
				VAR b: Texts.Buffer;
			BEGIN
				WHILE seq # NIL DO
					IF seq.sym = cmdSym THEN Ch("^"); Ch(seq.cmd)
					ELSIF seq.sym = nameSym THEN
						IF (name[1] = 0X) & ((name[0] < " ") OR (name[0] > 7EX)) THEN Char(name[0])
						ELSE FlipStr(seq.def.trig)
						END
					ELSE (*seq.sym = stretchSym*) Ch(22X); Append(W.buf, buf);
						NEW(b); Texts.OpenBuf(b); Texts.Copy(seq.stretch, b); Append(b, buf); Ch(22X)
					END;
					seq := seq.next; IF seq # NIL THEN Ch(" ") END
				END
			END Seq;
		BEGIN
			IF tree # NIL THEN
				Write(tree.left); Gap; FlipStr(tree.trig); Gap; Ch("("); Seq(tree.seq); Ch(")"); Ln; Write(tree.right)
			END
		END Write;
	BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
		IF (S.line # 0) OR (S.class # Texts.String) & (S.class # Texts.Name) THEN
			Oberon.GetSelection(text, beg, end, time);
			IF time > 0 THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) END
		END;
		IF (S.line # 0) OR (S.class # Texts.String) & (S.class # Texts.Name) THEN S.s[0] := 0X END;
		Str("(hotkey is "); Char(hotKey); Ch(")"); Ln;
		tree := NIL; Sort(defs.right, S.s, tree); Texts.OpenBuf(buf); Write(tree); Append(W.buf, buf);
		Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y); T := TextFrames.Text("");
		Texts.Append(T, buf);
		V := MenuViewers.New(TextFrames.NewMenu("EditKeys.Definitions", Menu),
			TextFrames.NewText(T, 0), TextFrames.menuH, x, y)
	END Definitions;
	PROCEDURE GetKeyCode*;	(*<<*)
	BEGIN Str("EditKeys.GetKeyCode  ('q' to quit)"); WLog;
		REPEAT Input.Read(ch); Ln; Gap; Char(ch); WLog UNTIL ch = "q";
		Ln; WLog
	END GetKeyCode;
BEGIN Texts.OpenWriter(W); Texts.OpenWriter(WB); 
	Texts.OpenWriter(WL);
	NEW(defs); NEW(dmy); NEW(buf); NEW(indent);
	map := "0123456789ABCDEF";
	ResetDefs;
	T := TextFrames.Text(DefaultFile); ReadText(DefaultFile, 0); T := NIL;
	InitialExec(InstallMacro)
END EditKeys.